home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / MEDICAL / 2608A.ZIP / GP.ZIP / 3YRLABCD.SRC next >
Text File  |  1990-11-03  |  11KB  |  590 lines
  1. ;\|
  2. ;3YRLABCD.SRC     Translated from 3YRLABCD.EDT by Roger Mathew's EDT2SRC Ver 4.11
  3. ;START    01:33:20 PM  21/ 6/90   |
  4. RECALLSX:
  5.     define(Z30|A|30||)
  6.     define(YES.NO|A|1||)
  7.     define(CHK_FLD|N|8||)
  8.     define(NUM_N|N|2||)
  9.     define(NUM|A|2||)
  10.     define(DATE_A|A|8||)
  11.     define(DATE_B|A|10||)
  12.     define(TO_DATE|S|8||)
  13.     define(WAIT|N|3||)
  14.     define(MEM_AD|A|22||)
  15.     define(SENT_DATE|S|8||)
  16.     define(CHK_DATE|S|8||)
  17.     define(PUNC2|N|2||)
  18.     define(CH_NAME|A|15||)
  19.     define(HIS|A|3||)
  20.     define(CLIN_DAY|A|25||)
  21.     define(CLIN_TIME|A|10||)
  22.     define(CNTR|N|2||)
  23.     define(FLAG|A|1||)
  24.     define(AMOUNTX|N|4||)
  25.     define(S10|A|10||)
  26.     define(DATECOD|S|8||)
  27.     define(CODER|A|5||)
  28.     define(C30|A|30||)
  29.     define(TM|A|27||4)
  30.     define(A30|A|30||)
  31.     define(CHOICE|N|1||)
  32.     define(TDND|S|8||)
  33.     define(DATERP|S|8||)
  34.     define(B30|A|30||)
  35.     define(S1|A|1||)
  36.     define(TD|S|8||)
  37.     define(A8|A|8||)
  38.     define(B8|A|8||)
  39.     define(YES.NO|A|1||)
  40.     define(N5|N|5||)
  41.     define(D1|A|1||)
  42.     define(NY|A|1||)
  43.     define(CODEX1|S|8||)
  44.     define(CTR|N|2||)
  45.     define(DATEN|N|2||)
  46.     define(DATEX|S|8||)
  47.     define(ARRAY1|A|30||3)
  48.     define(ARRAY2|A|22||3)
  49.     define(ARRAY3|A|22||3)
  50.     define(ARRAY4|A|4||3)
  51.     define(ARRAY5|S|8||3)
  52.     define(TIT|A|4||)
  53.     define(PATIENT1A|A|30||)
  54.     define(PUNC1|N|2||)
  55.     define(N.2.0.P|N|2||)
  56.     define(P.2.0.1|N|2||)
  57.     define(P.2.0.2|N|2||)
  58.     define(PATIENT2|A|30||)
  59.     define(P.2.0.3|N|2||)
  60.     define(RECTYPE1|A|4||)
  61.     define(RECTYPE2|A|4||)
  62.     define(PATIENT1|A|30||)
  63.     define(DOB1|D|10||)
  64.     define(DOB2|D|10||)
  65. STARTREC:
  66.     open(PATIENT||0|FILE_LOCK)
  67.     open(GPSETUP||0|)
  68.     D1 = ("")
  69.     date(TD|G)
  70.     YES.NO = ("")
  71.     DATEX = (0)
  72.     CODEX1 = (0)
  73.     NY = ("")
  74.     trap(I|G|PRINTSTOP)
  75.     trap(S|I)
  76.     trap(D|I)
  77.     trap(F|I)
  78.     trap(R|I)
  79.     trap(B|I)
  80.     trap(G|I)
  81.     trap(H|S|HELP)
  82.     trap(M|I)
  83.     trap(N|I)
  84.     trap(Q|G|MENU)
  85.     trap(J|G|LASTSEEN)
  86.     goto LASTSEEN
  87.     mount(RECALLS|S)
  88.     enter(RECTYPE1||||Y|Y|N|||N)
  89.     enter(RECTYPE2||||Y|Y|N|||N)
  90.     enter(CTR|"123456789"|||N|Y|N|||N)
  91.     enter(CODEX1|||RECALLSX|N|Y|N|||N)
  92. DATEXX:
  93.     NY = ("")
  94.     enter(YES.NO|"YN"|||Y|Y|N|||N)
  95. CODEX1:
  96. RECSTART:
  97.     COD.PAT.NAME = ("A")
  98.     find(G|COD.PAT.NAME|EXIT|N)
  99. RECTEST:
  100.     if COD[CTR] = ("HYS") goto NEXTRECALL
  101.     if COD[CTR] = ("VIR") goto NEXTRECALL
  102.     if COD[CTR] = ("REF") goto NEXTRECALL
  103.     if COD[CTR] = ("MOV") goto NEXTRECALL
  104.     if RECTYPE1 <> ("") then if RECTYPE1 > (COD[CTR]) goto NEXTRECALL
  105.     if RECTYPE2 <> ("") then if RECTYPE2 < (COD[CTR]) goto NEXTRECALL
  106.     if COD.D[CTR] > (CODEX1) goto NEXTRECALL
  107.     if COD.D[CTR] = (0) goto NEXTRECALL
  108.     RECORD.NUMBER = (COD.REF)
  109.     DATECOD = (COD.D[CTR])
  110.     CODER = (COD[CTR])
  111.     find(M|RECORD.NUMBER|EXIT|)
  112.     DATERP = (COD.D[CTR])
  113.     if NY = ("") do
  114.         {
  115.         gosub PRINTRECAL
  116.         }
  117.     else
  118.         {
  119.         gosub RECLABPRIN
  120.         }
  121. NEXTRECALL:
  122.     find(N|RECALLS|EXITX|)
  123.     goto RECTEST
  124. MOUNTRECAL:
  125.     mount(RPLABELS|R|P)
  126.     pchr(P|10)
  127.     pchr(P|11)
  128.     pchr(P|4)
  129.     pchr(P|1)
  130.     pset(132|66|60)
  131.     trap(I|G|PRINTSTOP)
  132.     trap(P|S|RECHEAD)
  133.     AMOUNTX = (0)
  134.     gosub RECHEAD
  135.     ret
  136. PRINTRECAL:
  137.     pfmt(18|||N|N|)
  138.     AMOUNTX = (AMOUNTX+1)
  139.     DATECOD = (0)
  140.     CODER = ("")
  141.     ret
  142. RECHEAD:
  143.     pfmt(16|||N|N|)
  144.     pfmt(17|||N|N|)
  145.     ret
  146. RECALLS:
  147.     trap(P|D)
  148.     ptof
  149.     if D1 = ("X") then goto RECALLSX
  150.     if YES.NO = ("Y") do
  151.         {
  152.         gosub RECLABS
  153.         }
  154.     else
  155.         {
  156.         goto RECALLSX
  157.         }
  158.     goto RECSTART
  159. TOPOF:
  160.     ptof
  161.     ret
  162. RECLABS:
  163.     NY = ("X")
  164.     trap(P|D)
  165.     trap(I|S|PRINTSTOP)
  166.     pchr(P|4)
  167.     mount(NEW|R|P)
  168.     pset(50|18|18)
  169.     D1 = ("X")
  170.     ret
  171. PRINT_LAB:
  172.     pblnk(4)
  173.     pfmt(1|||N|N|)
  174.     pblnk(2)
  175.     pfmt(2|||N|N|)
  176.     pblnk(2)
  177.     pfmt(3|||N|N|)
  178.     pblnk(4)
  179.     if FLAG = ("X") goto EXIT
  180.     ret
  181. CL_ARRAY:
  182.     clrmem(ARRAY1|3)
  183.     clrmem(ARRAY2|3)
  184.     clrmem(ARRAY3|3)
  185.     clrmem(ARRAY4|3)
  186.     clrmem(ARRAY5|3)
  187.     ret
  188. RECLABPRIN:
  189.     gosub SEXIST
  190.     gosub NEWX
  191.     NY = ("X")
  192.     DATECOD = (0)
  193.     CODER = ("")
  194.     CNTR = (CNTR+1)
  195.     ARRAY1[CNTR] = (Z30)
  196.     ARRAY2[CNTR] = (ADDRESS1)
  197.     ARRAY3[CNTR] = (AREA)
  198.     ARRAY4[CNTR] = (COD[CTR])
  199.     ARRAY5[CNTR] = (COD.D[CTR])
  200.     if CNTR = (3) gosub PRINT_LAB
  201.     ret
  202. EXITX:
  203.     if NY <> ("") do
  204.         {
  205.         CNTR = (2)
  206.         FLAG = ("X")
  207.         gosub RECLABPRIN
  208.         }
  209.     goto RECALLS
  210. REPONLY:
  211.     run("REPONLY")
  212. SEXIST:
  213.     if SEX = ("M") then TIT = ("Mr.")
  214.     if SEX = ("F") do
  215.         {
  216.         if MARITAL.STATUS = ("M") do
  217.             {
  218.             TIT = ("Mrs.")
  219.             }
  220.         else
  221.             {
  222.             TIT = ("Ms.")
  223.             }
  224.         }
  225.     if SEX = ("") then TIT = ("Ms.")
  226.     trim(TIT|T)
  227.     ret
  228. NEWX:
  229.     NY = (" ")
  230.     PATIENT1A = (PATIENT.NAME)
  231.     trim(PATIENT1A|T)
  232.     PUNC1 =loc(","|PATIENT1A|1||27)
  233.     N.2.0.P =siz(A|PATIENT.NAME)
  234.     P.2.0.1 = (PUNC1-1)
  235.     PATIENT2 =mid(PATIENT.NAME|1|P.2.0.1|)
  236.     P.2.0.2 = (PUNC1+2)
  237.     P.2.0.3 = (N.2.0.P-P.2.0.2+1)
  238.     PATIENT1 =mid(PATIENT1A|P.2.0.2|P.2.0.3|)
  239.     trim(PATIENT1|T)
  240.     trim(PATIENT2|T)
  241.     Z30 = (TIT+PATIENT1+NY+PATIENT2)
  242.     ret
  243. CLEARALL:
  244.     clr(PATIENT|B)
  245.     clr(RECALLS|B)
  246.     S1 = ("")
  247.     DATEX = (0)
  248.     YES.NO = ("")
  249.     ret
  250. EXIT:
  251.     run("recmenu")
  252. EXIT1:
  253.     run("recmenu")
  254. PRINTSTOP:
  255.     pon(S)
  256.     clrlne(1|25)
  257.     pmsg("CONTINUE ? (Y/N):"|30|12|N|N|S|)
  258.     enter(YES.NO|"YN"||PRINTSTOP|Y|Y|N|48|12|N)
  259.     if YES.NO <> ("Y") then run("recmenu")
  260.     pon(P)
  261.     ret
  262. MENU:
  263.     TM[1] = (" 1 - EXIT             01011")
  264.     menu(1|20|2|23|0|TM|CHOICE|1|22|MENU||"-------RECALLS--------"|N)
  265.     on(CHOICE|G|EXIT1|MENU)
  266. TRACE:
  267.     break
  268.     ret
  269. FILE_LOCK:
  270.     pmsg("FILE PATIENT AND/OR RECALLS IS IN USE - EXIT"|20|24|Y|N|S|)
  271.     clrlne(1|24)
  272.     run("recmenu")
  273. HELP:
  274.     saves(1)
  275.     window(1|23|22|78)
  276.     pmsg("                                    SMEAR RECALLS"|1|1|N|Y|S|)
  277.     pmsg("                                    ============="|1|2|N|Y|S|)
  278.     pmsg("1.USE UPDATE PROGRAM AND MAKE SURE ALL WOMEN BETWEEN 33 AND 65 ARE ENTERED"|1|3|N|Y|S|)
  279.     pmsg("2.ALL THESE WOMEN MUST HAVE A RECALL DATE."|1|4|N|Y|S|)
  280.     pmsg("3.RUN REPORT ONLY TO GET LATEST UPDATE ON TOTAL AT-RISK GROUP"|1|5|N|Y|S|)
  281.     pmsg("4.RECALL EVERY MONTH ON THE 16th + A DAY OR TWO"|1|6|N|Y||)
  282.     pmsg("5.CHECK OFF AGAINST RECALL LIST. ALL NON-ATTENDERS WILL BE ASKED AGAIN"|1|7|N|Y|S|)
  283.     pmsg("6.NON-ATTENDERS WILL BE THOSE WHO ARE MORE THAN ONE MONTH BEHIND"|1|8|N|Y||)
  284.     pmsg(""|1|9|N|Y|S|)
  285.     pmsg("                                    CODES"|1|10|N|Y|S|)
  286.     pmsg("                                    ====="|1|11|N|Y|S|)
  287.     pmsg("CODE 1 = SMEARS"|1|12|N|Y|S|)
  288.     pmsg("CODE 2 = CONTRACEPTION"|1|13|N|Y|S|)
  289.     pmsg("CODE 3 = IMMUNISATION"|1|14|N|Y|S|)
  290.     pmsg("CODE 4 = DIABETES"|1|15|N|Y|S|)
  291.     pmsg("CODE 5 = EPILEPSY"|1|16|N|Y|S|)
  292.     pmsg("CODE 6 = THYROID"|1|17|N|Y|S|)
  293.     pmsg("CODE 7 = ANGINA AND HEART DISEASE"|1|18|N|Y|S|)
  294.     pmsg("CODE 8 = ASTHMA"|1|19|N|Y|S|)
  295.     pmsg("CODE 9 = BP"|1|20|N|Y|S|)
  296.     pmsg(""|1|21|Y|N|S|)
  297.     redsp(1)
  298.     ret
  299. LASTSEEN:
  300.     trap(I|S|PRINTSTOP)
  301.     trap(J|G|STARTREC)
  302.     mount(LABS|S)
  303.     MEM_AD = ("1")
  304.     enter(MEM_AD||||Y|N|N|||N)
  305.     enter(TO_DATE||||N|N|N|||N)
  306.     enter(CHK_DATE||||N|N|N|||N)
  307.     enter(DOB1||||N|N|N|||N)
  308.     enter(DOB2||||N|N|N|||N)
  309.     SENT_DATE = (TD)
  310.     enter(YES.NO|"YN"|||Y|Y|N|||N)
  311.     if YES.NO <> ("Y") goto LASTSEEN
  312.     gosub RECLABS
  313.     ADDRESS1 = (MEM_AD)
  314.     find(G|ADDRESS1|EXIT|)
  315. TEST_SEEN:
  316.     if DATE.OF.BIRTH < (DOB1) goto NEXT_SEEN
  317.     if DATE.OF.BIRTH > (DOB2) goto NEXT_SEEN
  318.     if DATE_SEEN > (SEEN) do
  319.         {
  320.         SEEN = (DATE_SEEN)
  321.         save(PATIENT|N|N)
  322.         find(M|ADDRESS1||)
  323.         }
  324.     if SEEN > (DATE_SEEN) do
  325.         {
  326.         DATE_SEEN = (SEEN)
  327.         save(PATIENT|N|N)
  328.         find(M|ADDRESS1||)
  329.         }
  330.     if SEEN < (CHK_DATE) do
  331.         {
  332.         if SENT_FOR > (TO_DATE - 365) goto NEXT_SEEN
  333.         gosub PRINT_SEEN
  334.         SENT_FOR = (SENT_DATE)
  335.         save(PATIENT|N|N)
  336.         find(M|ADDRESS1||)
  337.         }
  338. NEXT_SEEN:
  339.     find(N|PATIENT|EXITXX|)
  340.     pmsg(RECORD.NUMBER|1|1|N|N|S|)
  341.     goto TEST_SEEN
  342. PRINT_SEEN:
  343.     gosub SEXIST
  344.     gosub NEWX
  345.     gosub SEEN_PRINT
  346.     ret
  347. SEEN_PRINT:
  348.     WAIT = (WAIT+1)
  349.     if WAIT = (195) do
  350.         {
  351.         pmsg(WAIT;" printed - change cards and press ret..."|10|20|Y|N|S|)
  352.         WAIT = (0)
  353.         }
  354.     pblnk(6)
  355.     pfmt(1|||N|N|)
  356.     pblnk(2)
  357.     pfmt(2|||N|N|)
  358.     pblnk(2)
  359.     pfmt(3|||N|N|)
  360.     pblnk(4)
  361.     pfmt(4|||N|N|)
  362.     ret
  363. EXITXX:
  364.     goto EXIT
  365. \R RPLABELS
  366. &                                      &                                        &
  367. &                                      &                                        &
  368. &                                      &                                        &
  369.  
  370. &    &                                 &    &                                   &    &
  371.  
  372.  
  373.  
  374.  
  375.  
  376.  
  377.       &
  378.            &
  379.               &
  380.       &
  381. PATIENT                - RECALL REPORT- &                                        CODE (& )
  382. ------------------------------------------------------------------------------------------
  383. &                             &                     &                      (&    )&         &     [&]
  384.  
  385.  
  386.  
  387.  
  388.  
  389.  
  390.  
  391.  
  392.  
  393.  
  394.  
  395.  
  396.  
  397.  
  398.  
  399.  
  400.  
  401.  
  402.  
  403.  
  404.  
  405.  
  406.  
  407.  
  408.  
  409.  
  410.  
  411.  
  412.  
  413.  
  414. \
  415. ARRAY1[1]
  416. ARRAY1[2]
  417. ARRAY1[3]
  418. ARRAY2[1]
  419. ARRAY2[2]
  420. ARRAY2[3]
  421. ARRAY3[1]
  422. ARRAY3[2]
  423. ARRAY3[3]
  424. ARRAY4[1]
  425. ARRAY5[1]
  426. ARRAY4[2]
  427. ARRAY5[2]
  428. ARRAY4[3]
  429. ARRAY5[3]
  430. Z30
  431. ADDRESS1
  432. AREA
  433. DATERP
  434. TD
  435. CTR
  436. PATIENT.NAME
  437. ADDRESS1
  438. AREA
  439. CODER
  440. DATECOD
  441. AMOUNTX
  442. DOCTOR
  443. \
  444. \STRECALLS 
  445.  
  446.  
  447.  
  448.  
  449.                   YOU MAY JUMP TO PRINT "NOT SEEN" LABELS
  450.  
  451.       This will recall all recall code 1 except "HYS;VIR;MOV;REF;ETC"
  452.  
  453.                                    RECALLS
  454.                  ╔════════════════════════════════════════╗
  455.                  ║                                        ║
  456.                  ║  From Code:&     to  Code:&            ║
  457.                  ║                                        ║
  458.                  ║ Recall code:[& ]                       ║
  459.                  ║                                        ║
  460.                  ║ Up to Date:&                 Labels?:& ║
  461.                  ╚════════════════════════════════════════╝
  462.                F1 - Help   "Printer on for labels" Esc - Exit
  463.  
  464.  
  465.  
  466.  
  467.  
  468.  
  469. \
  470. RECTYPE1
  471. RECTYPE2
  472. CTR
  473. CODEX1
  474. YES.NO
  475. \
  476. \STNOTE    
  477.                          RECALLS - WHAT TO DO
  478.                          ====================
  479.  
  480. 1. TO TAG ALL POTENTIAL RECALLS ANSWER RUN RECALLS AT RISK FROM MAIN MENU.
  481.  
  482.   (THIS WILL TAG A GIVEN AGE GROUP WITH CODE <****>)
  483.  
  484. 2. TO UPDATE THE <****> USE EASY SMEAR /IMMUNISATION UPDATE PROGRAM.
  485.  
  486. 3. IF YOU ANSWER NO TO REPORT ONLY YOU WILL PRINT A LIST OF OUTSTANDING
  487.    RECALLS WITH OR WITHOUT LABELS.
  488.  
  489. 6. PRINT OUT THESE AND SEND TO PATIENTS.
  490.  
  491. 7. UPDATE  RESULTS USING EASY RECALL MAINTENANCE
  492.  
  493.         NOTE: THIS PROGRAM WILL ALWAYS PRINT OUT "ALL" OUTSTANDING RECALLS.
  494.  
  495.                           ========================
  496.  
  497.  
  498.  
  499.  
  500.  
  501. \
  502. \
  503. \STLABS    
  504.  
  505.  
  506.  
  507.  
  508.  
  509.  
  510.                   PRINTS ADDRESSES ON CARDS FOR 3 YEAR CHECK
  511.                    ╔═══════════════════════════════════════╗
  512.                    ║ From Address:&                        ║
  513.                    ║ Target Date :&          eg 01/04/91   ║
  514.                    ║ 3 years ago :&          eg 01/04/88   ║
  515.                    ║ From Dob 75 :&          eg 01/04/1914 ║
  516.                    ║ To Dob   16 :&          eg 01/04/1975 ║
  517.                    ║     CONTINUE:&                        ║
  518.                    ╚═══════════════════════════════════════╝
  519.                      REQUIRES CARDS IN PRINTER REVERSE SIDE
  520.                           Esc - Exit or stop printing
  521.  
  522.  
  523.  
  524.  
  525.  
  526.  
  527.  
  528. \
  529. MEM_AD
  530. TO_DATE
  531. CHK_DATE
  532. DOB1
  533. DOB2
  534. YES.NO
  535. \
  536. \R NEW     
  537.         &
  538.            &
  539.                &
  540. -
  541.  
  542.  
  543.  
  544.  
  545.  
  546.  
  547.  
  548.  
  549.  
  550.  
  551.  
  552.  
  553.  
  554.  
  555.  
  556.  
  557.  
  558.  
  559.  
  560.  
  561.  
  562.  
  563.  
  564.  
  565.  
  566.  
  567.  
  568.  
  569.  
  570.  
  571.  
  572.  
  573.  
  574.  
  575.  
  576.  
  577.  
  578.  
  579.  
  580.  
  581.  
  582.  
  583.  
  584.  
  585. \
  586. Z30
  587. ADDRESS1
  588. AREA
  589. \
  590.